﻿Imports System.Net.Sockets
Imports System.ComponentModel
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Threading
Public Class WebServer
    Enum RecvState
        WaitHead
        WaitBinID
        WaitBinLen
        WaitBinData
        'ASCII码消息 >0001+data, 以>开头，后面四个字节表示数据长度，data是数据体
        WaitStrLen
        WaitStrData
    End Enum

    Enum MessageId
        Register
        ServerState
        MaxId
    End Enum

    Public Const TcpTimeout = 1500

    Public Delegate Sub FrameHandler(frame As Byte(), id As Byte, tail As Byte)
    Public Delegate Sub MessageHandler(id As Byte)
    Public Delegate Sub JsonHandler(data As String)

    Public server As TcpListener
    Private _TcpConnected As Boolean = False
    Private client As TcpClient
    Private _Listening As Boolean = True

    Public SendQueue As New Queue(Of Byte())
    Public FrameMap As Dictionary(Of Byte, FrameHandler) = New Dictionary(Of Byte, FrameHandler) From {
        {MessageId.Register, AddressOf RegisterHandler}
    }
    Public OnMessage As MessageHandler
    Public OnJsonMessage As JsonHandler

    <Description("TCP/IP连接状态")>
    Public ReadOnly Property TcpConnected As Boolean
        Get
            If client Is Nothing Then
                Return False
            End If
            If client.Client Is Nothing Then
                Return False
            End If
            Return _TcpConnected
        End Get
    End Property

    <Description("Tcp接收缓存数据大小")>
    Public ReadOnly Property BytesToRead As Integer
        Get
            If client Is Nothing Then
                Return 0
            End If

            If client.Client Is Nothing Then
                Return 0
            End If

            Return client.Client.Available
        End Get
    End Property

    <Description("Tcp Server在接收数据中")>
    Public Property ServerReceiving As Boolean

    <Description("Tcp Server在发送数据中")>
    Public Property ServerSending As Boolean

    '设置为上线状态，配置TcpClient
    Private Sub TcpSetOnline()
        _TcpConnected = True
    End Sub
    '设置为离线状态，释放资源
    Private Sub TcpSetOffline()
        _TcpConnected = False
        If client IsNot Nothing Then
            client.Close()
        End If
    End Sub

    Public Sub Listen(port As Integer)
        ServerReceiving = False
        ServerSending = False
        If server Is Nothing Then
            server = TcpListener.Create(port)
        Else
            Console.WriteLine("Server Already Exists")
            Return
        End If

        Console.WriteLine($"Start Listening At {port}")
        server.Start()

        While _Listening

            Dim cl As TcpClient = server.AcceptTcpClient()
            If TcpConnected Then
                If client IsNot Nothing Then
                    Console.WriteLine($"Only One Connection Can be Established, Current Connection Will be Closed.")
                    TcpSetOffline()
                    Dim tick = Now.Ticks
                    While ServerReceiving Or ServerSending
                        '等待上一个连接实例的接收线程退出
                        If Now.Ticks - tick > 20 Then
                            Console.WriteLine($"Close Time Out. ServerReceiving:{ServerReceiving}, ServerSending:{ServerSending}.")
                            ServerReceiving = False
                            ServerSending = False
                            Exit While
                        End If
                    End While
                    client.Dispose()
                End If
            End If
            client = cl
            ' 设置收发超时
            client.Client.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.SendTimeout, TcpTimeout)
            client.Client.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.ReceiveTimeout, TcpTimeout)
            Console.WriteLine($"Connetion Established From {client.Client.RemoteEndPoint}")
            TcpSetOnline()
            Dim t1 = New Thread(AddressOf RecvTask)
            Dim t2 = New Thread(AddressOf SendTask)
            t1.Start()
            t2.Start()
        End While

    End Sub

    Public Sub Write(s As String)
        Dim b = Encoding.UTF8.GetBytes(s)
        Write(b)
    End Sub

    Public Sub Write(valSendBuffer As Byte())
        If Not TcpConnected Then Return
        SendQueue.Enqueue(valSendBuffer)
    End Sub

    Public Function ReadByte() As Byte
        Dim b(0) As Byte
        client.Client.Receive(b, 1, SocketFlags.None)
        'WebPort.PrintBytes(b)
        Return b(0)
    End Function

    Public Function Read(buffer() As Byte, offset As Integer, count As Integer) As Integer
        Dim ret = client.Client.Receive(buffer, offset, count, SocketFlags.None)
        Return ret
    End Function

    Public Function Read(count As Integer) As String
        Dim b(count - 1) As Byte
        Dim ret As String
        client.Client.Receive(b)
        Try
            ret = Encoding.ASCII.GetString(b)
        Catch ex As Exception
            Console.WriteLine(ex.Message)
            ret = "{""id"":255,""cnt"":0,""data"":""" + ex.Message + """}"
        End Try
        Return ret
    End Function

    Public Sub DiscardInBuffer()

        If Not TcpConnected Then Return

        If client.Client.Available > 0 Then
            Dim buf() As Byte
            ReDim buf(client.Client.Available)
            client.Client.Receive(buf)
            Console.WriteLine("[Discard Buffer]")
            WebPort.PrintBytes(buf)
        End If

    End Sub

    Public Function GenerateMessage(s As String) As String
        Dim len = s.Length.ToString().PadLeft(4, "0"c)
        Dim ret = ">" + len + s
        'Debug.Print(ret)
        Return ret
    End Function

    Private Sub SendTask()
        Console.WriteLine("Server Start Send ...")
        ServerSending = True
        While TcpConnected
            If SendQueue.Count > 0 Then
                Dim d = SendQueue.Dequeue()
                Try
                    client.Client.Send(d)
                Catch ex As Exception
                    Console.WriteLine(ex.Message)
                End Try
            Else
                Thread.Sleep(1)
            End If
        End While
        ServerSending = False
        Console.WriteLine("Server Send Loop Stopped .")
    End Sub

    Private Sub RecvTask()
        Dim recv_state = RecvState.WaitHead
        Dim head(2) As Byte
        Dim frame() As Byte
        Dim frame_len As UInteger

        Console.WriteLine("Server Start Receiving...")
        ServerReceiving = True
        While TcpConnected
            If BytesToRead = 0 Then Thread.Sleep(1)

            If BytesToRead > 0 Then
                Select Case recv_state
                    Case RecvState.WaitHead
                        ReDim head(2)
                        head(0) = ReadByte()
                        If head(0) = &H5A Then recv_state = RecvState.WaitBinID
                        If head(0) = Encoding.ASCII.GetBytes(">")(0) Then recv_state = RecvState.WaitStrLen
                    Case RecvState.WaitBinID
                        head(1) = ReadByte()
                        recv_state = RecvState.WaitBinLen
                    Case RecvState.WaitStrLen
                        '四字节表示字符串长度，例如0023，表示23个字节
                        If BytesToRead >= 4 Then
                            Dim len_buf(3) As Byte
                            Read(len_buf, 0, 4)
                            Dim str_len = Encoding.ASCII.GetString(len_buf)
                            Try
                                frame_len = Convert.ToUInt16(str_len)
                            Catch ex As Exception
                                Console.WriteLine(ex.Message)
                                recv_state = RecvState.WaitHead
                                Exit Select
                            End Try
                            If frame_len = 0 Then
                                recv_state = RecvState.WaitHead
                                Exit Select
                            End If
                            recv_state = RecvState.WaitStrData
                        End If
                    Case RecvState.WaitBinLen
                        head(2) = ReadByte()
                        frame_len = head(2) + 2
                        recv_state = RecvState.WaitBinData
                    Case RecvState.WaitBinData
                        If BytesToRead >= frame_len Then
                            recv_state = RecvState.WaitHead
                            ReDim frame(frame_len + 2)
                            Read(frame, 3, frame_len)
                            Array.Copy(head, frame, 3)
                            WebPort.PrintBytes(frame)
                            ParseBin(frame, head(1))
                        End If
                    Case RecvState.WaitStrData
                        If BytesToRead >= frame_len Then
                            recv_state = RecvState.WaitHead
                            Dim str_data = Read(frame_len)
                            If OnJsonMessage IsNot Nothing Then
                                OnJsonMessage.Invoke(str_data)
                            End If
                        End If
                End Select
            End If
        End While
        ServerReceiving = False
        Console.WriteLine("Server Stopped.")
    End Sub

    ''' <summary>
    ''' 解析协议
    ''' </summary>
    ''' <param name="frame">待解析的帧</param>
    ''' <param name="id">发送的时候的ID</param>
    Private Sub ParseBin(frame As Byte(), id As Byte)

        If id >= MessageId.MaxId Then
            Console.WriteLine("Error Frame Id")
            Return
        Else
            Dim len As Integer = frame(2)
            Dim parsed_len = len + 5

            If frame.Length < parsed_len Then
                Console.WriteLine("No Enough Bytes to Parse")
                Return
            End If

            Dim crc_get As Byte = frame(len + 3)
            Dim crc_buf(len + 2) As Byte
            Dim tail_cnt = frame(frame.Length - 1)
            Array.Copy(frame, crc_buf, crc_buf.Length)

            If crc_get <> Calculate.Sum(crc_buf) Then
                Console.WriteLine("Error CRC")
                Return
            End If

            FrameMap(id).Invoke(frame, id, tail_cnt)
            If OnMessage IsNot Nothing Then
                OnMessage.Invoke(id)
            End If

        End If

    End Sub

    Private Function ParseToObject(frame As Byte(), st As Object) As Object
        Dim data_len = Marshal.SizeOf(st)
        Dim data_bytes(data_len) As Byte
        Array.Copy(frame, 3, data_bytes, 0, data_len)
        Return Transport.ByteToStruct(data_bytes, st.GetType())
    End Function


    ''' <summary>
    ''' 生成要发送的协议
    ''' </summary>
    ''' <param name="msg_id">信息类型</param>
    ''' <param name="data_struct">数据结构体</param>
    ''' <param name="tail_cnt">尾部计数值，用于帧同步</param>
    ''' <returns></returns>
    Public Function GenerateMsg(msg_id As MessageId, tail_cnt As Byte, Optional data_struct As Object = Nothing) As Byte()
        Dim tx_buffer(4) As Byte
        Dim data_buf() As Byte = Nothing
        tx_buffer(0) = &H5A
        tx_buffer(1) = msg_id

        Dim data_len As Integer
        If data_struct IsNot Nothing Then
            data_len = Marshal.SizeOf(data_struct)
            data_buf = Transport.StructToByte(data_struct)
            tx_buffer(2) = data_len
        Else
            data_len = 0
            tx_buffer(2) = 0
        End If

        ReDim Preserve tx_buffer(data_len + 4)

        If data_buf IsNot Nothing Then
            Array.Copy(data_buf, 0, tx_buffer, 3, data_buf.Length)
        End If

        Dim crc As Byte = Calculate.Sum(tx_buffer)
        tx_buffer(tx_buffer.Length - 2) = crc
        tx_buffer(tx_buffer.Length - 1) = tail_cnt
        Return tx_buffer
    End Function

    Private Sub RegisterHandler(frame As Byte(), id As Byte, tail As Byte)
        Write(GenerateMsg(id, tail))
    End Sub

End Class
